home *** CD-ROM | disk | FTP | other *** search
/ Night Owl 6 / Night Owl's Shareware - PDSI-006 - Night Owl Corp (1990).iso / 026a / tl_form.zip / TL_FORM.COD < prev    next >
Text File  |  1990-08-19  |  39KB  |  1,241 lines
  1. // Module Name: FORM.COD FOR 1.1
  2. // Description: This module produces dBASE IV .FMT files
  3. //              with popups for VALID clause field validation and
  4. //              Context Sensitive Help for each field
  5. //
  6.  
  7. Format (.fmt) File Template with POPUP field validation
  8. -------------------------------------------------------
  9. Version 1.1.19
  10. Ashton-Tate (c) 1987, 1988, 1989, 1990
  11. Written by Kirk J. Nason & Bill Ramos
  12. Modified by Tony Lima 08/18/90 to allow REQUIRED clause with
  13.   VALID.  To add a REQUIRED, insert the following before
  14.   your other logical conditions:
  15.     'REQ'='REQ' .AND. <rest of logical condition here>
  16.   Note that this works because 'REQ'='REQ' always returns
  17.   a logical .T.  The template looks for this string,
  18.   writes the word REQUIRED to the FMT file, then resets
  19.   the logical condition to only keep everything beyond the
  20.   blank space after the .AND.
  21.  
  22.   WARNING:  BE SURE YOU USE EXACTLY THE SYNTAX SHOWN HERE,
  23.   INCLUDING ALL BLANK SPACES.
  24.  
  25. This template will support POPUPs for VALID clause field validations and
  26. context sensitive help for each field.
  27.  
  28. Example: In "ACCEPT value when" under "Edit options" enter,
  29.         "POPUP" = "vendor->vendor_id ORDER vendor_id REQ SHADOW"
  30.         --------------------------------------------------------
  31.         this will activate a popup if the data entered is invalid for
  32.         that field and will also make the field REQUIRED.
  33.  
  34. Explanation of the POPUP string follows:
  35.  
  36. POPUP              Indicates that a popup will be used for this field.
  37. vendor->vendor_id  Indicates the .DBF to open and FIELD to use as validation.
  38. ORDER vendor_id    Indicates which INDEX TAG to SEEK in.
  39. REQ                Indicates the FIELD requires data (can't be empty).
  40.                    Leave REQ out if the field is NOT required.      OPTIONAL!
  41. SHADOW             Use shadowing effect on popups                   OPTIONAL!
  42. NOTE: The POPUP string must be entered with the quotes as in the example.
  43.  
  44. --------------------------------------------------------------------------------
  45.  
  46. Explanation of the Context Sensitive Help file follows:
  47.  
  48. If you want to create your own help file, here is the structure that is required.
  49.  
  50. Structure for Help Database (.dbf):
  51. <first 6 chars. of the format file name>_H.dbf
  52.  
  53. Field   Field Name  Type        Width  Dec   Tag
  54. -------------------------------------------------
  55.     1   FLD_NAME    Character     10         Yes  Field name to lookup on F1
  56.     2   FLD_HEADNG  Character     25          No  Heading to show user on window
  57.     3   FLD_HELP    Memo          10          No  Help text to show user
  58. -------------------------------------------------
  59.         Total                     46
  60. {
  61. include "form.def"    // Form selectors
  62. include "builtin.def" // Builtin functions
  63. //
  64. // Enum string constants for international translation
  65. //
  66. enum  wrong_class = "Can't use FORM.GEN on non-form objects.  ",
  67.       form_empty  = "Form design was empty.  ",
  68.       bad_pick    = "Picklist coordinates exceed column 79 - move field left",
  69.       bad_shadow  = "Shadow coordinates exceed column 79 - move field left",
  70.       select_msg1 = "[Select: ]+CHR(17)+CHR(196)+CHR(217)+[   Cancel: Esc]",
  71.       help_msg1   = "Scroll thru Help: Ctrl-Home   Exit Viewing Help: Esc   ",
  72.       help_msg2   = "See Original Screen: F3"
  73. ;
  74. enum  offset = 3; // Offset for lmarg()
  75. //
  76.  
  77. if FRAME_CLASS != form then // We are not processing a form object
  78.   pause(wrong_class + any_key)
  79.   goto NoGen;
  80. endif
  81.  
  82. var  fmt_name,     // Format file name
  83.      crlf,         // line feed
  84.      carry_flg,    // Flag to test carry loop
  85.      carry_cnt,    // Count of the number of fields to carry
  86.      carry_len,    // Cumulative length of carry line until 75 characters
  87.      carry_lent,   // Total cumulative length of carry line
  88.      carry_first,  // Flag to test "," output for carry fields
  89.      color_flg,    // Flag to if color should stay on am line
  90.      line_cnt,     // Count for total lines processed (Mulitple page forms)
  91.      page_cnt,     // Count for total pages processed (Mulitple page forms)
  92.      temp,         // tempory work variable
  93.      cnt,          // Foreach loop variable
  94.      wnd_cnt,      // Window counter
  95.      wnd_names,    // Window names so I can clear them at the bottom of the file
  96.      default_drv,  // dBASE default drive
  97.      dB_status,    // dBASE status before entering designer
  98.      scrn_size,    // Screen size when generation starts
  99.      left_delimiter, // Delimiter to put around SAY
  100.      right_delimiter,// Delimiter to put around SAY
  101.      max_pop_row,  // Maximum row that a popup or shadow can start
  102.      display,      // Type of display screen we are on
  103.      is_popup,     // POPUP validation requested
  104.      is_help,      // HELP (context sensitive) requested
  105.      udf_file,     // UDF file has been created
  106.      hlp_name,     // HELP .dbf name
  107.      trow_positn,  // Temporary variable for row_positn
  108.      tcol_positn,  // Temporary variable for col_positn
  109.      at_pop,       // "POPUP" is in FLD_OK_COND
  110.      color;        // Color returned from getcolor function
  111.  
  112.  //-----------------------------------------------
  113.  // Assign default values to some of the variables
  114.  //-----------------------------------------------
  115.  carry_flg = carry_first = carry_cnt = carry_len = carry_lent =
  116.  wnd_cnt = line_cnt =  color_flg = cnt = 0
  117.  crlf = chr(10)
  118.  temp = ""
  119.  page_cnt = 1
  120.  is_popup = is_help = udf_file = 0
  121.  left_delimiter = right_delimiter = "\""
  122.  
  123.  screen_size()
  124.  //-------------------------------
  125.  // Create Format file
  126.  //-------------------------------
  127.  if !make_Fmt() then goto nogen
  128.  
  129.  header()                   // Print Header in the Format file
  130.  fmt_file_initialization()  // Format file initializtion code
  131.  fmt_file_body()            // @ SAY GET Processing
  132.  fmt_file_exit()            // Format file exit code
  133.  make_pop_code()            // Create the Procedure File for POPUP's if required
  134.  make_help_code()           // Make procedures for the help system
  135.  
  136.  if cnt == 0 then
  137.     pause(form_empty + any_key)
  138.  endif
  139.  fileerase(fmt_name+".FMO")
  140.  nogen:
  141. return 0;
  142.  
  143.  
  144. //---------------------------------------
  145. // Template user defined functions follow
  146. //---------------------------------------
  147.  
  148. define fmt_file_initialization()
  149. //
  150. // Format file initialization code
  151. //
  152. }
  153.  
  154. *-- Format file initialization code --------------------------------------------
  155.  
  156. *-- Some of these PRIVATE variables are created based on CodeGen and may not 
  157. *-- be used by your particular .fmt file
  158. PRIVATE lc_talk, lc_cursor, lc_display, lc_status, lc_carry, lc_proc,;
  159.         ln_typeahd, gc_cut
  160.  
  161. IF SET("TALK") = "ON"
  162.    SET TALK OFF
  163.    lc_talk = "ON"
  164. ELSE
  165.    lc_talk = "OFF"
  166. ENDIF
  167. lc_cursor = SET("CURSOR")
  168. SET CURSOR ON
  169. {if at("43", display_type()) then}
  170.  
  171. *-- This form was created in {display_type()} mode
  172. lc_display = SET("display")
  173. // MONO, COLOR, EGA25, EGA43, MONO43
  174. IF .NOT. "43" $ lc_display                             && In 25 line mode
  175.    IF "EGA" $ lc_display
  176.       *-- If EGA is in lc_display try EGA43
  177.       SET DISPLAY TO EGA43                     
  178.    ELSE
  179.       *-- Otherwise try MONO43
  180.       SET DISPLAY TO MONO43
  181.    ENDIF
  182. ENDIF
  183. {endif}
  184.  
  185. lc_status = SET("STATUS")
  186. *-- SET STATUS was \
  187. {if dB_status then}
  188. ON when you went into the Forms Designer.
  189. IF lc_status = "OFF"
  190.    SET STATUS ON
  191. {else}
  192. OFF when you went into the Forms Designer.
  193. IF lc_status = "ON"
  194.    SET STATUS OFF
  195. {endif}
  196. ENDIF
  197. //-----------------------------------------------------------------------
  198. // Process fields to build "SET CARRY" and WINDOW commands.
  199. //-----------------------------------------------------------------------
  200. {
  201.  foreach FLD_ELEMENT flds
  202.    new_page(flds)
  203.    if FLD_CARRY then carry_flg = 1; ++carry_cnt endif
  204.    if chr(FLD_VALUE_TYPE) == "M" and FLD_MEM_TYP and wnd_cnt < 20 then
  205.       ++wnd_cnt
  206.       wnd_names = wnd_names + "wndow" + wnd_cnt + ",";
  207. }
  208.  
  209. *-- Window for memo field {cap_first(FLD_FIELDNAME)}.
  210. DEFINE WINDOW { Window_Def(flds)}\
  211. {  endif
  212.  next flds
  213.  print(crlf);
  214.  if carry_flg then
  215. }
  216.  
  217. lc_carry = SET("CARRY")
  218. *-- Fields to carry forward during APPEND.
  219. SET CARRY TO { Carry_Flds()}
  220.  
  221. {endif}
  222. {
  223.  if check_for_popups() then
  224. }
  225.  
  226. ON KEY LABEL F2 ?? chr(7)
  227.  
  228. lc_proc = SET("procedure")                       && Store procedure file name
  229. SET PROCEDURE TO u_{substr(name,1,6)}
  230.  
  231. {    endif
  232.      if check_for_help() then
  233.         if !is_popup then}
  234. lc_proc = SET("procedure")                       && Store procedure file name
  235. SET PROCEDURE TO u_{substr(name,1,6)}
  236. {       endif}
  237. ON KEY LABEL F1 DO Help WITH VARREAD()
  238. {    endif
  239. return;
  240. // eof - fmt_file_init()
  241. enddef
  242.  
  243. //--------------------------------------------------------------
  244. define fmt_file_body()
  245. }
  246.  
  247. *-- @ SAY GETS Processing. -----------------------------------------------------
  248.  
  249. *--  Format Page: {page_cnt = 1
  250.                    page_cnt}
  251.  
  252. {line_cnt = wnd_cnt = 0
  253.  foreach ELEMENT k
  254.    color = getcolor(FLD_DISPLAY, FLD_EDITABLE) // get color of element
  255.    if new_page(k) then
  256. }
  257. READ
  258.  
  259. *-- Format Page: {page_cnt}
  260.  
  261. {  endif
  262. //
  263.  
  264.    if ELEMENT_TYPE == @TEXT_ELEMENT or ELEMENT_TYPE == @FLD_ELEMENT then
  265.      if FLD_FIELDTYPE == calc then
  266. }
  267. *-- Calculated field: {cap_first(FLD_FIELDNAME)} - {FLD_DESCRIPT}
  268. {    endif
  269.      if FLD_FIELDTYPE == memvar then
  270. }
  271. *-- Memory variable: {cap_first(FLD_FIELDNAME)}
  272. {    endif}
  273. @ {nul2zero(ROW_POSITN) - line_cnt},{nul2zero(COL_POSITN)} \
  274. {  endif
  275.    if ELEMENT_TYPE == @BOX_ELEMENT then
  276. }
  277. @ {box_coordinates(k)}\
  278. {  endif}
  279. //
  280. {  case ELEMENT_TYPE of
  281.    @TEXT_ELEMENT:
  282.    // Certain control characters can cause dBASE problems ie, ASCII(13,26,0)
  283.    // so the form designer will either send them to us as a string if they are
  284.    // all the same character or as individual characters if they differ. We
  285.    // handle this by using the chr() function to "SAY" them in dBASE.
  286. }
  287. SAY \
  288. {     if asc(TEXT_ITEM) < 32 then
  289.         if len(TEXT_ITEM) == 1 then}
  290. CHR({asc(TEXT_ITEM)}) \
  291. {       else}
  292. REPLICATE(CHR({asc(TEXT_ITEM)}), {len(TEXT_ITEM)}) \
  293. {       endif
  294.       else
  295.          if substr(TEXT_ITEM,1,1) == "\"" then
  296.             // Double quote is being used on the design surface need to use
  297.             // brackets "[]" as delimiters
  298.             left_delimiter = "["
  299.             right_delimiter = "]"
  300.          endif
  301.          left_delimiter + TEXT_ITEM + right_delimiter} \
  302. {        left_delimiter = right_delimiter = "\""
  303.       endif
  304.       outcolor()}
  305. {  @Box_element:
  306.        outbox(BOX_TYPE, BOX_SPECIAL_CHAR)}
  307. {      outcolor()}
  308. {  @FLD_ELEMENT:
  309.       if !FLD_EDITABLE then; // its a SAY}
  310. SAY \
  311. {        if FLD_FIELDTYPE == calc then
  312.            // Loop thru expression in case it is longer than 237
  313.             foreach FLD_EXPRESSION fcursor in k
  314.                FLD_EXPRESSION}
  315. {           next}
  316. // Output a space after the Fld_expression and get ready for picture clause
  317.  \
  318. {        else // not a editable field
  319.             if FLD_FIELDTYPE == dbf then temp = "" else temp = "m->" endif
  320.                temp + cap_first(FLD_FIELDNAME)} \
  321. {        endif
  322.          if Ok_Template(k) then}
  323. PICTURE "{picture_for_say(k);}" \
  324. {        endif
  325.       else // it's a get}
  326. GET \
  327. {        if FLD_FIELDTYPE == dbf then temp = "" else temp = "m->" endif
  328.          temp + cap_first(FLD_FIELDNAME)} \
  329. {        if chr(FLD_VALUE_TYPE) == "M" && FLD_MEM_TYP then
  330.             if wnd_cnt < 20  then ++wnd_cnt endif
  331.             if Fld_mem_typ == 1}OPEN {endif}WINDOW wndow{wnd_cnt} \
  332. {        endif
  333.          if Ok_Template(k) then}
  334. PICTURE "{picture_for_get(k);}" \
  335. {        endif
  336.          if FLD_L_BOUND or FLD_U_BOUND then color_flg = 1;}
  337. ;
  338.    RANGE {FLD_L_BOUND}{if FLD_U_BOUND then},{FLD_U_BOUND}{endif} \
  339. {        endif
  340.          if FLD_OK_COND then color_flg = 1;}
  341. ;
  342. {           if at("POPUP", upper(ltrim(FLD_OK_COND))) == "2" and
  343.                ok_coordinates( k, 2, 1, bad_pick ) then
  344.                // A POPUP is desired for showing coded values, redo the
  345.                // VALID clause to call a UDF based on "U_" + FLD_FIELDNAME
  346. }
  347.    VALID {if is_required(FLD_OK_COND)}REQUIRED {endif}\
  348. {  get_udfname(FLD_FIELDNAME)}( {cap_first(FLD_FIELDNAME)} ) \
  349. {
  350.             else
  351.                 if !(at("POPUP", upper(ltrim(FLD_OK_COND))) == "2") then
  352. }
  353. {
  354. // tl, 08/18/90.  Added REQ to VALID
  355.                   if at("'REQ'='REQ'",upper(FLD_OK_COND))==1 then
  356. }
  357.    VALID REQUIRED {SUBSTR(FLD_OK_COND,19)} \
  358. {
  359.                    else
  360. }
  361.    VALID {FLD_OK_COND} \
  362. {
  363.                   endif
  364.                 endif
  365.             endif
  366.  
  367.             if FLD_REJ_MSG then}
  368. ;
  369.    ERROR \
  370. {              if !at("IIF", upper(FLD_REJ_MSG))}"{endif}{FLD_REJ_MSG}\
  371. {              if !at("IIF", upper(FLD_REJ_MSG))}"{endif} \
  372. {           endif
  373.          endif // FLD_OK_COND
  374.          if FLD_ED_COND then color_flg = 1;}
  375. ;
  376.    WHEN {FLD_ED_COND} \
  377. {
  378.          endif
  379.          if FLD_DEF_VAL then color_flg = 1;}
  380. ;
  381.    DEFAULT {FLD_DEF_VAL} \
  382. {        endif
  383.          if FLD_HLP_MSG then color_flg = 1;}
  384. ;
  385.    MESSAGE \
  386. {           if !at("IIF", upper(FLD_HLP_MSG))}"{endif}{FLD_HLP_MSG}\
  387. {           if !at("IIF", upper(FLD_HLP_MSG))}"{endif} \
  388. {        endif
  389.       endif // FLD_EDITABLE
  390. }
  391. {     outcolor()}
  392. {     color_flg = 0;
  393.    otherwise: goto getnext;
  394.    endcase
  395. }
  396.  
  397. //Leave the above blank line, it forces a line feed!
  398. //-----------------
  399. // End of @ SAY GET
  400. //-----------------
  401. {  ++cnt;
  402.    getnext:
  403.  next k
  404. return;
  405. // eof - fmt_file_body()
  406. enddef
  407.  
  408. //--------------------------------------------------------------
  409. define fmt_file_exit()
  410. }
  411. *-- Format file exit code -----------------------------------------------------
  412.  
  413. *-- SET STATUS was \
  414. {if dB_status then}
  415. ON when you went into the Forms Designer.
  416. IF lc_status = "OFF"  && Entered form with status off
  417.    SET STATUS OFF     && Turn STATUS "OFF" on the way out
  418. {else}
  419. OFF when you went into the Forms Designer.
  420. IF lc_status = "ON"  && Entered form with status on
  421.    SET STATUS ON     && Turn STATUS "ON" on the way out
  422. {endif}
  423. ENDIF
  424. {if carry_flg then}
  425.  
  426. SET CARRY &lc_carry.
  427. {endif}
  428. SET CURSOR &lc_cursor.
  429. SET TALK &lc_talk.
  430. {if at("43", display_type()) then}
  431. SET DISPLAY TO &lc_display.      && Reset Screen size if changed
  432. {endif}
  433. {if wnd_names then}
  434.  
  435. RELEASE WINDOWS {substr(wnd_names, 1, (len(wnd_names) - 1))}
  436. {endif}
  437.  
  438. RELEASE {if carry_flg then}lc_carry,{endif}lc_talk,lc_fields,lc_status
  439. {    if is_help then}
  440.  
  441. ON KEY LABEL F1
  442. {    endif
  443.      if is_popup or is_help then}
  444. ON KEY LABEL F2
  445.  
  446. SET PROCEDURE TO (lc_proc)
  447. {    endif}
  448. *-- EOP: {filename(fmt_name)}FMT
  449. {return;
  450. // eof - fmt_file_exit()
  451. enddef
  452.  
  453. //--------------------------------------------------------------
  454. define picture_for_get(c)
  455.      if c.FLD_PICFUN then}@{c.FLD_PICFUN}\
  456. {       if at("S", c.FLD_PICFUN) then}{c.FLD_PIC_SCROLL}{endif}\
  457.  {//leave this space}\
  458. {       endif
  459.      if at("M", c.FLD_PICFUN) then
  460.         c.FLD_PIC_CHOICE}\
  461. {    else
  462.         c.FLD_TEMPLATE}\
  463. {    endif
  464.  return;
  465. enddef
  466.  
  467. //--------------------------------------------------------------
  468. define picture_for_say(c)
  469.      if c.FLD_PICFUN then}@{c.FLD_PICFUN}\
  470. {       if at("S", c.FLD_PICFUN) then}{c.FLD_PIC_SCROLL}{endif}\
  471.  {//leave this space}\
  472. {       endif
  473.      if !at("M", c.FLD_PICFUN) then
  474.         c.FLD_TEMPLATE}\
  475. {    endif
  476.  return;
  477. enddef
  478.  
  479. //--------------------------------------------------------------
  480. define make_pop_code()
  481. // Create the Procedure File for POPUP's if required
  482.      if is_popup then
  483.           if !make_udf() then 
  484.               return 0;
  485.           endif
  486.           udf_header()
  487. }
  488. FUNCTION Empty                && Determine if the passed argument is NULL
  489. PARAMETER x
  490.   mtype = TYPE("x")
  491.   DO CASE
  492.     CASE mtype = "C"
  493.       retval = (LEN(TRIM(x))=0)
  494.     CASE mtype$"NF"
  495.       retval = (x=0)
  496.     CASE mtype = "D"
  497.       retval = (" "$DTOC(x))
  498.   ENDCASE
  499. *-- EOP: empty
  500. RETURN (retval)
  501.  
  502. {
  503.           line_cnt = 0
  504.           page_cnt = 1
  505.  
  506.           foreach FLD_ELEMENT flds
  507.  
  508.                at_pop = at("POPUP", upper(ltrim(FLD_OK_COND))) == "2" ? 1 : 0;
  509.  
  510.                new_page(flds)
  511.                if at_pop then
  512.                     trow_positn = nul2zero(ROW_POSITN) - line_cnt
  513.                     tcol_positn = nul2zero(COL_POSITN)
  514.                     color = getcolor(FLD_DISPLAY, FLD_EDITABLE) // get color of element
  515.  
  516.                     if !ok_coordinates(flds, 2, 0, "") then loop endif
  517.  
  518.  
  519.                     print("*"+replicate("-",78)+crlf);}
  520. FUNCTION {get_udfname(FLD_FIELDNAME)}
  521.   PARAMETER fld_name
  522.   PRIVATE ALL LIKE ??_*
  523.   PRIVATE esckey, fld_name, rtn_fld
  524.   ll_return = .F.
  525.  
  526. {                   if !is_required(FLD_OK_COND) then}
  527.   IF empty(fld_name)                   && Not a required fiel cur.FLD_TEMPLATE
  528.      RETURN (.T.)                       && if null field
  529.   ENDIF
  530.  
  531. {                    endif}
  532.   EscKey = 27                          && 27 represents the ESC key
  533.  
  534.   lc_alias = ALIAS()                   && Grab current workarea
  535.   SELECT SELECT()
  536.   USE {get_file(FLD_OK_COND)} ORDER {get_key(FLD_OK_COND)} AGAIN
  537.  
  538.  
  539.   lc_exact = SET("EXACT")              && Store value of EXACT
  540.   SET EXACT ON
  541.  
  542. {                   if chr(FLD_VALUE_TYPE) == "C" then}
  543.   fld_name = IIF( EMPTY( TRIM( fld_name)), fld_name, TRIM( fld_name))
  544. {                   endif}
  545.   SEEK fld_name
  546.  
  547.   SET EXACT &lc_exact.                 && Restore SET EXACT to org. value
  548.   IF .NOT. FOUND()
  549.  
  550.       DEFINE POPUP {get_popname(FLD_OK_COND)} FROM \
  551. {         if trow_positn < max_pop_row then
  552.              trow_positn + 1},{tcol_positn} ;
  553.         TO {scrn_size-1},{tcol_positn + len(FLD_TEMPLATE) + 1} ;
  554. {         else
  555.              trow_positn - 11},{tcol_positn} ;
  556.         TO {trow_positn - 1},{tcol_positn + len(FLD_TEMPLATE) + 1} ;
  557. {         endif}
  558.         PROMPT FIELD {get_field(FLD_OK_COND)} ;
  559.         MESSAGE {select_msg1}
  560.  
  561.       ON SELECTION POPUP {get_popname(FLD_OK_COND)} DEACTIVATE POPUP
  562.  
  563. {                        if chr(FLD_VALUE_TYPE) == "C" then}
  564.       KEYBOARD TRIM(fld_name)
  565. {                   endif}
  566.       SAVE SCREEN TO temp
  567. {                   if is_shadow(FLD_OK_COND) and
  568.                        ok_coordinates( flds, 4, 1, bad_shadow ) then
  569. }
  570.       DO shadowg WITH {get_pop_shadow(FLD_TEMPLATE);}
  571.  
  572. {                   endif
  573. }
  574.       ACTIVATE POPUP {get_popname(FLD_OK_COND)}
  575.  
  576.       rtn_fld = PROMPT()                         && Get user choice from Piclist
  577.  
  578.       RELEASE POPUP {get_popname(FLD_OK_COND)}
  579.  
  580.       RESTORE SCREEN FROM temp
  581.  
  582.       IF LASTKEY() <> EscKey
  583.         @ {trow_positn},{tcol_positn} GET rtn_fld \
  584. {        if Ok_Template(flds) then}
  585. PICTURE "{picture_for_get(flds);}" \
  586. {           outcolor()}
  587. {        endif}
  588.  
  589.         CLEAR GETS
  590.  
  591.         REPLACE {cap_first(FLD_FILENAME)}->{cap_first(FLD_FIELDNAME)} WITH \
  592. {        if chr(FLD_VALUE_TYPE) == "C" then}
  593. rtn_fld
  594. {        else}
  595. VAL(rtn_fld)
  596. {        endif}
  597.  
  598.         ll_return = .T.
  599.       ELSE
  600.         ll_return = .F.
  601. {
  602.                     if !is_required(FLD_OK_COND) then
  603. }
  604.         IF EMPTY(fld_name)               && Not a required field, so return
  605.           ll_return = .T.
  606.         ENDIF
  607.  
  608. {
  609.                     endif
  610. }
  611.       ENDIF
  612.  
  613.   ELSE
  614.       ll_return = .T.
  615.   ENDIF
  616.  
  617.   USE
  618.   SELECT (lc_alias)                    && Go back to the edit file
  619.  
  620. *-- EOP: {get_udfname(FLD_FIELDNAME)}
  621. RETURN (ll_return)
  622.  
  623. {
  624.                endif
  625.           next flds
  626.           print("*"+replicate("-",78)+crlf);}
  627.  
  628. {    endif
  629.      return;
  630. // eof - make_pop_code()
  631. enddef
  632.  
  633. //--------------------------------------------------------------
  634. define make_help_code()
  635. //------------------------------------
  636. // Make procedures for the help system
  637. //------------------------------------
  638. if is_help then
  639.      // If the udf file has not already been created, make it.
  640.     if not udf_file then
  641.        if !make_udf() then 
  642.            return 0;
  643.        endif
  644.        // Put up the UDF header
  645.        udf_header()
  646.     endif
  647.     // Make procedures for the help system
  648.     make_help()
  649. endif
  650. if is_help or is_popup then
  651.    // Make shadow procedures
  652.    make_shadow_procs()
  653. endif
  654. return;
  655. enddef
  656.  
  657. //--------------------------------------------------------------
  658. define header()
  659.     // Print Header in program
  660.     print( replicate( "*",80) + crlf);}
  661. *-- Name.......: {filename(fmt_name)}FMT
  662. *-- Date.......: {ltrim( substr( date(),1,8))}
  663. *-- Version....: dBASE IV, Format {FRAME_VER}.1
  664. *-- Notes......: Format files use "" as delimiters!
  665. {   print( replicate( "*",80) + crlf);
  666. enddef
  667.  
  668. //--------------------------------------------------------------
  669. define udf_header()
  670.     // Print Header in UDF program
  671.     print("*"+replicate("-",78)+crlf);}
  672. *-- Name....: {frame_path}u_{rtrim(substr(name,1,6))}.PRG
  673. *-- Date....: {ltrim(SUBSTR(date(),1,8))}
  674. *-- Version.: dBASE IV, Procedure for Format {Frame_ver}.1
  675. *-- Notes...: Procedure file for VALID POPUPs and/or Context Sensitive Help
  676. *-- ........: for {filename(fmt_name)}FMT
  677. {print("*"+replicate("-",78)+crlf);
  678. enddef
  679.  
  680. //--------------------------------------------------------------
  681. define ok_template(cur)
  682.      if cur.FLD_TEMPLATE && !(chr(cur.FLD_VALUE_TYPE) == "D" ||
  683.                               chr(cur.FLD_VALUE_TYPE) == "M") then
  684.         return 1;
  685.      else
  686.         return 0;
  687.      endif
  688. enddef
  689.  
  690. //--------------------------------------------------------------
  691. define ok_coordinates(cur,              // Current cursor
  692.                       xtra_width,       // Additional width to check ie, shadow
  693.                       want_message,     // Display message flag 0:No 1:Yes
  694.                       message)          // Message to display to user
  695.      // Check to see if coordinates of popup or shadow will fit on screen
  696.      // based on the dimensions of the current field
  697.      if nul2zero(cur.COL_POSITN) + len(cur.FLD_TEMPLATE) + xtra_width > 80 then
  698.         if want_message then
  699.            beep(2)                      // UDF in builtin.def
  700.            cls()
  701.            say_center(10,"Error on Field: " + cur.FLD_FIELDNAME)
  702.            say_center(12, message)
  703.            pause(any_key)
  704.         endif
  705.         return 0;
  706.      else
  707.         return 1;
  708.      endif
  709. enddef
  710.  
  711. //--------------------------------------------------------------
  712. define screen_size()
  713.    // Test screen size if display > 2 screen is 43 lines
  714.    display = numset(_flgcolor)
  715.    if display > ega25 then
  716.        scrn_size = 39
  717.        max_pop_row = 36
  718.    else
  719.        max_pop_row = 18
  720.        scrn_size = 21
  721.    endif
  722.  
  723.    // Test to see if status was off before going into form designer
  724.    dB_status = numset(_flgstatus)
  725.    if scrn_size == 21 and !db_status then
  726.       scrn_size = 24
  727.       max_pop_row = 21
  728.    endif
  729.    if scrn_size == 39 and !db_status then // status is off
  730.       scrn_size = 42
  731.       max_pop_row = 39
  732.    endif
  733.    return;
  734. enddef
  735.  
  736. //--------------------------------------------------------------
  737. define display_type()
  738.     // Find out the display type we are working on
  739.     var temp;
  740.     case display of
  741.        mono:   temp = "MONO"
  742.        cga:    temp = "COLOR"
  743.        ega25:  temp = "EGA25"
  744.        mono43: temp = "MONO43"
  745.        ega43:  temp = "EGA43"
  746.      endcase
  747.      return temp;
  748. enddef
  749.  
  750. //--------------------------------------------------------------
  751. define getcolor(f_display,         // Color of the current field
  752.                 f_editable         // Field is SAY or GET
  753.                )
  754.  // Determines the color from f_display and f_editable (GET or SAY)
  755.  enum  Foreground  =   7,
  756.        Intensity   =   8,  // Color
  757.        Background  = 112,
  758.        MIntensity  = 256,
  759.        Reverse     = 512,  // Mono
  760.        Underline   =1024,
  761.        Blink       =2048,
  762.        default     =32768; // Screen set to default
  763.  
  764.  var forgrnd, enhanced, backgrnd, blnk, underln, revrse, use_colors, incolor;
  765.  incolor=""
  766.  
  767.  use_colors  = default & f_display
  768.  forgrnd  = Foreground & f_display
  769.  enhanced = (Intensity & f_display) || (MIntensity & f_display)
  770.  backgrnd = Background & f_display
  771.  blnk     = Blink  & f_display
  772.  underln  = Underline & f_display
  773.  revrse   = Reverse & f_display
  774.  
  775.  if not use_colors then // Use system colors, no colors set in designer
  776.  
  777.     if backgrnd then backgrnd = backgrnd/16 endif
  778.  
  779.     if (display != mono and display != mono43) then
  780.        case forgrnd of
  781.         0: incolor = "n"
  782.         1: incolor = "b"
  783.         2: incolor = "g"
  784.         3: incolor = "bg"
  785.         4: incolor = "r"
  786.         5: incolor = "rb"
  787.         6: incolor = "gr"
  788.         7: incolor = "w"
  789.        endcase
  790.     else
  791.        incolor = "w"
  792.     endif
  793.  
  794.     if revrse then
  795.        incolor = incolor + "i"
  796.     endif
  797.     if underln then
  798.        incolor = incolor + "u"
  799.     endif
  800.     if enhanced then
  801.        incolor = incolor + "+"
  802.     endif
  803.     if blnk then
  804.        incolor = incolor + "*"
  805.     endif
  806.  
  807.     incolor = incolor + "/"
  808.  
  809.     if (display != mono and display != mono43) then
  810.        case backgrnd of
  811.         0: incolor = incolor + "n"
  812.         1: incolor = incolor + "b"
  813.         2: incolor = incolor + "g"
  814.         3: incolor = incolor + "bg"
  815.         4: incolor = incolor + "r"
  816.         5: incolor = incolor + "rb"
  817.         6: incolor = incolor + "gr"
  818.         7: incolor = incolor + "w"
  819.        endcase
  820.     else
  821.        incolor = incolor + "n"
  822.     endif
  823.  
  824.     if f_editable and incolor then
  825.        incolor = incolor + "," + incolor
  826.     endif
  827.  
  828.  endif // use no colors
  829.  return alltrim(incolor);
  830. enddef
  831.  
  832. //--------------------------------------------------------------
  833. define outbox(mbox,            // Border type
  834.               mchar            // Special character of border
  835.              )
  836.    // Output the of Box border and character if any
  837.    var result;
  838.    case mbox of
  839.       0: result = " " // single
  840.       1: result = " DOUBLE "
  841.       2: result = " CHR("+mchar+") "
  842.    endcase
  843.    return result;
  844. enddef
  845.  
  846. //--------------------------------------------------------------
  847. define outcolor()
  848.   // Output the of color of the @ SAY GET or Box
  849.   var result;
  850.   result = "";
  851.   if len(color) > 0 then
  852.      if color_flg then
  853.         // If flag is set output a dBASE continuation ";"
  854.         result = ";" + crlf + space(3)
  855.      endif
  856.      result = result + "COLOR " + color + " "
  857.   endif
  858.   return result;
  859. enddef
  860.  
  861. //--------------------------------------------------------------
  862. define window_def(cur)
  863.    // Build dBASE window command
  864.    var result;
  865.    result = "wndow" + wnd_cnt + " FROM " + Box_Coordinates(cur)
  866.    result = result + outbox(cur.BOX_TYPE, cur.BOX_SPECIAL_CHAR)
  867.    color = getcolor(cur.FLD_DISPLAY, cur.FLD_EDITABLE)
  868.    result = result + outcolor()
  869.    return result;
  870. enddef
  871.  
  872. //--------------------------------------------------------------
  873. define box_coordinates(cur)             // Pass in foreach cursor
  874.    // Build box coordinates for a dBASE window command
  875.    var result, temp_page, line_cnt;
  876.    temp_page = page_cnt;
  877.  
  878.    // Adjust box coordinates so that negative numbers are not generated
  879.    do while ( nul2zero(cur.BOX_TOP) - (scrn_size * temp_page) ) <= 1
  880.          temp_page = temp_page - 1
  881.    enddo
  882.    if page_cnt == 1 then
  883.         temp_page = 0
  884.    endif
  885.    if page_cnt == 2 then
  886.         temp_page = 1
  887.    endif
  888.    if !temp_page then
  889.       line_cnt = 0
  890.    else
  891.       line_cnt = (scrn_size * temp_page) + (1 * temp_page)
  892.    endif
  893.  
  894.    result = nul2zero(cur.BOX_TOP) - line_cnt +","
  895.    result = result + nul2zero(cur.BOX_LEFT) + " TO "
  896.    temp = nul2zero(cur.BOX_TOP) + cur.BOX_HEIGHT - line_cnt - 1
  897.    if temp > scrn_size then temp = scrn_size endif
  898.    result = result + temp + "," + (nul2zero(cur.BOX_LEFT) + cur.BOX_WIDTH - 1)
  899.    return result;
  900. enddef
  901.  
  902. //--------------------------------------------------------------
  903. define carry_flds()
  904.    // Build dBASE SET CARRY command
  905.    carry_len = carry_lent = 13
  906.    carry_first = 0
  907.    foreach FLD_ELEMENT flds
  908.       if FLD_CARRY then
  909.          carry_len = carry_len + len(FLD_FIELDNAME + ",")
  910.          carry_lent = carry_lent + len(FLD_FIELDNAME + ",")
  911.          if carry_lent > 1000 then
  912.             print(crlf + "SET CARRY TO ")
  913.             carry_len = carry_lent = 13
  914.          endif
  915.          if carry_len > 75 then print(";" + crlf + "  ")  carry_len = 2 endif
  916.          temp = cap_first(FLD_FIELDNAME)
  917.          if !carry_first then
  918.             print(temp)
  919.             carry_first = 1
  920.          else
  921.             print("," + temp)
  922.          endif
  923.       endif
  924.     next flds
  925.     print(" ADDITIVE");
  926.  return;
  927. enddef
  928.  
  929. //--------------------------------------------------------------
  930.  
  931. define make_fmt()
  932.    // Attempt to create program (fmt) file.
  933.    default_drv = strset(_defdrive)  // grab default drive from dBASE
  934.    fmt_name = FRAME_PATH + NAME     // Put path on to object name
  935.    if not fileok(fmt_name) then
  936.       if !default_drv then
  937.          fmt_name = NAME
  938.       else
  939.          fmt_name = default_drv + ":" + NAME
  940.       endif
  941.    endif
  942.    fmt_name = upper(fmt_name)
  943.    if not create(fmt_name+".FMT") then
  944.         pause(fileroot(fmt_name) +".FMT" + read_only + any_key)
  945.         return 0;
  946.      endif
  947.    return 1;
  948. enddef
  949. //--------------------------------------------------------------
  950.  
  951. define make_udf()
  952.    // Attempt to create dBASE procedure (prg) file.
  953.    var udf_root_file_name;
  954.    udf_root_file_name =  frame_path + "u_" + rtrim(substr(name,1,6))
  955.    if not create( udf_root_file_name + ".PRG") then
  956.       pause(udf_root_file_name + ".PRG" + read_only + any_key)
  957.       return 0;
  958.    endif
  959.    // Force dBASE to recompile the .prg
  960.    fileerase(udf_root_file_name + ".DBO")
  961.    udf_file = 1 // Global flag to determine if UDF file was created
  962.    return 1;
  963. enddef
  964.  
  965. //--------------------------------------------------------------
  966. define check_for_popups()
  967. // Check for "popup" string for this fmt file
  968. foreach FLD_ELEMENT flds
  969.     if at("POPUP", upper(ltrim(FLD_OK_COND))) == "2" then
  970.        is_popup = 1
  971.        exit
  972.     endif
  973. next flds
  974. return is_popup;
  975. enddef
  976.  
  977. //--------------------------------------------------------------
  978. define check_for_help()
  979.    // Check for help support for this fmt file
  980.    // Looking for a .dBF with the same name as the .fmt file
  981.    hlp_name = frame_path + substr(fileroot(fmt_name), 1, 6) + "_H"
  982.  
  983.    if fileexist(hlp_name + ".DBF") and fileexist(hlp_name + ".DBT") then
  984.       is_help = 1      // Global flag for help support
  985.    endif
  986. return is_help;
  987. enddef
  988.  
  989. //--------------------------------------------------------------
  990. define new_page(cur)               // Cur: Current cursor
  991.    // Checks for a page break and adjusts line_cnt and page_cnt
  992.    if nul2zero(cur.ROW_POSITN) - line_cnt > scrn_size then
  993.       line_cnt = line_cnt + scrn_size + 1;
  994.       ++page_cnt;
  995.       return 1;
  996.    endif
  997. return 0;
  998. enddef
  999.  
  1000. //--------------------------------------------------------------
  1001. define parse_line( before,         // Out: chars before the look_for string
  1002.                    input,          // In:  line being parsed
  1003.                    look_for        // In:  string searched for
  1004.                  )                 // Rtn: chars after the look_for string
  1005. // If the look_for sting is not found, the before sting will equal the
  1006. // input string, and the returned value will be NUL
  1007.      var location;
  1008.  
  1009.      location = at(look_for, UPPER(input))
  1010.      if location == 0 then
  1011.           before = input
  1012.           return ( "" );
  1013.      endif
  1014.  
  1015.      before = substr( input, 1, location-1)
  1016.      return ( substr( input,
  1017.                       location+len(look_for),
  1018.                       len(input)
  1019.                     )
  1020.             );
  1021.  
  1022. // end: parse_line()
  1023. enddef
  1024.  
  1025. //--------------------------------------------------------------
  1026. // Parsing routines for pulling objects out of the VALID string
  1027. // "POPUP" = "file->fld_name ORDER key_fld REQ"
  1028. // 1234567890123456789012345678901234567890123
  1029. //            1         2         3         4
  1030. define get_file(valid_str)
  1031.      var  s_arrow,            // String "->"
  1032.           test,
  1033.           s_equal,            // String "="
  1034.           next_alpha,
  1035.           at_alias,
  1036.           s_before,           // String before the searched for item
  1037.           r_target,           // Remainder of the target string after item
  1038.           use_name;           // Return for file
  1039.  
  1040.      s_arrow = "->"
  1041.      s_equal = "="
  1042.      r_target = parse_line( s_before, valid_str, s_equal )      // ' "file->...'
  1043.      next_alpha = atalpha(r_target)                             // 3
  1044.      at_alias = at(s_arrow, r_target)                           // 7
  1045.      use_name = substr(r_target,next_alpha,at_alias-next_alpha) // 'file'
  1046.  
  1047.      return cap_first(use_name);
  1048. enddef
  1049.  
  1050. //--------------------------------------------------------------
  1051. define get_key(valid_str)
  1052.      var  s_order,            // String "ORDER "
  1053.           at_space,
  1054.           s_before,           // String before the searched for item
  1055.           r_target,           // Remainder of the target string after item
  1056.           order_tag;          // Search TAG to ORDER BY
  1057.  
  1058.      s_order = "ORDER "
  1059.      r_target = parse_line( s_before, valid_str, s_order ) // 'key_fld REQ'
  1060.      at_space = at(" ",r_target)
  1061.      if at_space == 0 then
  1062.           order_tag = substr(r_target, 1, len(r_target)-1) // 'key_fld"'
  1063.      else
  1064.           order_tag = substr(r_target, 1, at_space-1)
  1065.      endif
  1066.      return cap_first(order_tag);
  1067. enddef
  1068.  
  1069. //--------------------------------------------------------------
  1070. define get_field(valid_str)
  1071.      var  s_arrow,            // String "->"
  1072.           at_space,
  1073.           s_before,           // String before the searched for item
  1074.           r_target,           // Remainder of the target string after item
  1075.           fld_name;           // Field name to lookup in target file
  1076.  
  1077.      s_arrow = "->"
  1078.      r_target = parse_line( s_before,
  1079.                             valid_str, s_arrow ) // 'fld_name ORDER...'
  1080.      at_space = at(" ",r_target)
  1081.  
  1082.      fld_name = ( at_space == 0 ? r_target : substr(r_target, 1, at_space-1) );
  1083.  
  1084.      return cap_first(fld_name);
  1085. enddef
  1086.  
  1087. //--------------------------------------------------------------
  1088. define get_popname(valid_str)
  1089.      // Create popup name
  1090.      return ( lower( "u_" + substr( get_field( valid_str),1,6) ) );
  1091. enddef
  1092.  
  1093. //--------------------------------------------------------------
  1094. define get_pop_shadow(field_template)   // Pass in FLD_TEMPLATE to deter. shadow
  1095.      if trow_positn < max_pop_row then
  1096.         trow_positn + 1},{tcol_positn},{scrn_size-1},{tcol_positn+len(Field_template)+1}
  1097. {    else
  1098.         trow_positn - 11},{tcol_positn},{trow_positn - 1},{tcol_positn+len(Field_template)+1}
  1099. {    endif
  1100.      return;
  1101. enddef
  1102.  
  1103. //---------------------------------------------------------------
  1104. define get_udfname(fld_str)
  1105.      // Create UDF name
  1106.      return cap_first( "u_" + substr( fld_str,1,6) );
  1107. enddef
  1108.  
  1109. //--------------------------------------------------------------
  1110. define is_required(valid_str)
  1111.      // Determines if the field is required before moving to the next field
  1112.      return ( ( at(" REQ ",  upper(valid_str)) ? 1 : 0 ) or
  1113.      ( at(" REQ\"", upper(valid_str)) ? 1 : 0 )
  1114.      );
  1115. enddef
  1116.  
  1117. //--------------------------------------------------------------
  1118. define is_shadow(valid_str)
  1119.      // Determines if the user wants shadowing for popup
  1120.      return ( ( at(" SHADOW ",  upper(valid_str)) ? 1 : 0 ) or 
  1121.               ( at(" SHADOW\"", upper(valid_str)) ? 1 : 0 )
  1122.             );
  1123. enddef
  1124.  
  1125. //--------------------------------------------------------------
  1126. define make_shadow_procs()
  1127.      // Make the dBASE code for shadowing
  1128.      print("*"+replicate("-",78)+crlf);
  1129. }
  1130. PROCEDURE Shadowg                       && displays shadow that grows
  1131.   PARAMETER x1,y1,x2,y2
  1132.   PRIVATE   x1,y1,x2,y2
  1133.  
  1134.   x0 = x2+1
  1135.   y0 = y2+2
  1136.   dx = 1
  1137.   dy = (y2-y1) / (x2-x1)
  1138.   DO WHILE x0 <> x1 .OR. y0 <> y1+2
  1139.      @ x0,y0 FILL TO x2+1,y2+2 COLOR n+/n
  1140.      x0 = IIF(x0<>x1,x0 - dx,x0)
  1141.      y0 = IIF(y0<>y1+2,y0 - dy,y0)
  1142.      y0 = IIF(y0<y1+2,y1+2,y0)
  1143.   ENDDO
  1144.  
  1145. RETURN
  1146. *-- EOP: shadowg
  1147. {    return;
  1148. enddef
  1149.  
  1150. //--------------------------------------------------------------
  1151.  define make_help()
  1152. // Make the dBASE code for help
  1153. }
  1154. PROCEDURE Help
  1155. {    lmarg(offset)}
  1156. *-- Activates the HELP window
  1157. PARAMETER lc_var
  1158. PRIVATE ALL LIKE ??_*
  1159. SET CURSOR OFF
  1160.  
  1161. *-- Select workarea and open Help dbf
  1162. lc_area = ALIAS()
  1163. SELECT SELECT()
  1164. USE {fileroot(hlp_name)} ORDER fld_name NOUPDATE   && Open HELP .dbf
  1165.  
  1166. SEEK lc_var
  1167. IF FOUND()                             && If found show Help
  1168.   ln_t = 5
  1169.   ln_l = 6
  1170.   ln_b = 15
  1171.   ln_r = 74
  1172.   ON KEY LABEL F3 DO Toggle
  1173.   DEFINE WINDOW z_help FROM ln_t+1, ln_l+2 TO ln_b-1, ln_r-2 NONE
  1174.   ON ERROR lc_error=error()
  1175.   SAVE SCREEN TO zz_help
  1176.  
  1177.   *-- Make Help Box
  1178.   DO shadowg WITH ln_t, ln_l, ln_b, ln_r
  1179.   @ ln_t+1, ln_l+1 CLEAR TO ln_b-1, ln_r-1
  1180.   @ ln_t, ln_l TO ln_b, ln_r DOUBLE
  1181.  
  1182.   ln_memline = SET("MEMO")
  1183.   SET MEMOWIDTH TO 65
  1184.   IF MEMLINES(fld_help) > 9
  1185.     @ ln_t+1,ln_r SAY CHR(24)
  1186.     @ ln_b-1,ln_r SAY CHR(25)
  1187.   ENDIF
  1188.   lc_string = CHR(185)+ [ Help for ] + TRIM(fld_headng) +[ ] + CHR(204)
  1189.   lc_message = IIF(MEMLINES(fld_help) > 9, ;
  1190.                   "{help_msg1 + help_msg2}", ;
  1191.                   "{help_msg2}" ;
  1192.                   )
  1193.  
  1194.   @ ln_t,CENTER(lc_string,80) SAY lc_string
  1195.   @ 0,0 GET fld_help OPEN WINDOW z_help MESSAGE lc_message
  1196.   READ
  1197.   SET MEMOWIDTH TO ln_memline
  1198.   ON ERROR
  1199.   ON KEY LABEL F3
  1200.   RELEASE WINDOW z_help
  1201.   RESTORE SCREEN FROM zz_help
  1202.   RELEASE SCREEN zz_help
  1203. ENDIF
  1204. SET MESSAGE TO
  1205. SET CURSOR ON
  1206. USE                                              && Close help file
  1207. SELECT (lc_area)                                 && Back to edit work area
  1208. {    lmarg(0)}
  1209. RETURN
  1210. *-- EOP: HELP
  1211.  
  1212. {    print("*"+replicate("-",78)+crlf);}
  1213. PROCEDURE Toggle
  1214. {    lmarg(offset)}
  1215. *-- Toggles the Help message back to the original screen
  1216. SAVE SCREEN to Toggle
  1217. RESTORE SCREEN FROM zz_help
  1218. SET MESSAGE TO "Press any key..."
  1219. mwait = INKEY(15)
  1220. RESTORE SCREEN FROM Toggle
  1221. RELEASE SCREEN Toggle
  1222. SET MESSAGE TO "Scroll thru Help: Ctrl-Home   Exit Viewing Help: Ctrl-End   See Org. Screen: F3"
  1223. {    lmarg(0)}
  1224. RETURN
  1225. *-- EOP: Toggle
  1226.  
  1227. {    print("*"+replicate("-",78)+crlf);}
  1228. FUNCTION Center
  1229. *-- UDF to center a string.
  1230. *-- lc_string = String to center
  1231. *-- ln_width = Width of screen to center in
  1232. *--
  1233. *-- Ex. @ 15,center(string,80) say string
  1234. *-- Will center the <string> withing 80 columns
  1235. PARAMETER lc_string, ln_width
  1236. RETURN ((ln_width/2)-(LEN(lc_string)/2))
  1237. {return;
  1238. enddef
  1239. // EOP FORM.COD
  1240. }
  1241.